home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
MWCC03
/
MDITOOL.ZIP
/
MDITOOL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-08-18
|
25KB
|
742 lines
{**********************************************************************}
{* *}
{* Microworks Sample Application *}
{* *}
{* for Borland Pascal v7.0 and Turbo Pascal for Windows v1.5 *}
{* *}
{* Copyright 1992-93 Jeff Franks (Microworks) Sydney, Australia. *}
{* *}
{* You are free to use, modify, reproduce and distribute the *}
{* Sample Files (and/or any modified version) in any way you *}
{* find useful. *}
{* *}
{**********************************************************************}
{*** Introduction
Application := MDI Window with moveable tool bar.
Files := MDITool.pas, MDITool.res
Units Required := FileDlg, MObjects, MCommDlg and MWCC.dll
Purpose := MDITool shows you how to,
1. Set up a moveable toolbar in a MDI window.
2. Use an SFX 'file open' and an MWCC 'file save as' dialog box.
3. Use an MWCC 'Font' common dialog box.
4. Use some of the button and static objects in the MWCC library.
Tabs := 2
Screen := 800 * 600
Date := August 1993.
This updated version of MDITool adds one of the new common Font dialog boxes (TMWCCFontDlg)
and shows off one of the new buttons, the Font button, that replaces the Find button (the eye)
in earlier versions.
MDITool shows you how to set up a moveable tool bar in a MDI window without going
to all the code that the 'MFileApp' toolbar sample in BP 7.0 does (all 39K of it).
MDITool is a streamlined piece of code (12K) that accomplishes the same thing without
using separate objects for the toolbar and each tool.
I didn't add anything else like an editor etc., you can do that. I wanted to keep it
simple, only showing you how to set up a moveable toolbar and use some of the standard
MWCC buttons and objects.
You can add a status bar in the same way as the toolbar eg. by using a raised TMWCCStatic
object, a text TMWCCStatic object and shortening the height of the client area.
TMWCCBmpButton is a Borland Style (3 bitmaps) button object. If you want a smaller toolbar
just create your own bitmaps, two or three for TMWCCBmpButton or one for TMWCCButton.
***}
program MDITool;
{$R MDITool.res}
uses WinTypes, WinProcs, WinDos, Win31, Strings, ToolHelp, CommDlg,
MObjects, MMsgBox, MCommDlg, FileDlg,
{$IFDEF Ver15}
WObjects;
{$ELSE}
Objects, OWindows, ODialogs;
{$ENDIF}
const
{*** Toolbar Constants ***}
ctl_Top = 101;
ctl_Left = 102;
ctl_Right = 103;
{*** Button ID's ***}
idw_But1 = 201;
idw_But2 = 202;
idw_But3 = 203;
idw_But4 = 204;
idw_But5 = 205;
idw_But6 = 206;
{*** Static ID ***}
idw_Stat1 = 401;
idd_Stat1 = 402;
idd_Stat2 = 403;
{*** Option Menu ID's ***}
idm_TopToolbar = 701;
idm_LeftToolbar = 702;
idm_RightToolbar = 703;
idm_About = 704;
{*** Speaks for itself ***}
AppName : PChar = 'MDITool';
type
PAboutDialog = ^TAboutDialog;
TAboutDialog = object(TMWCCDialog)
{***
TMWCCBmpButton is a BWCC style bitMap button object. TMWCCStatic is a static object
that displays either raised, recessed or normal static controls. WMDrawItem is required
to draw the TMWCCBmpButton ownerdraw button object.
***}
OkBut : PMWCCBmpButton;
Stat1, Stat2 : PMWCCStatic;
constructor Init (AParent: PWindowsObject; AName, ABmp: PChar);
procedure SetUpWindow; virtual;
procedure WMDrawItem (var Msg: TMessage); virtual wm_First + wm_DrawItem;
end;
PMDIButton = ^TMDIButton;
TMDIButton = object(TMWCCBmpButton)
{***
This object declares the buttons as non-MDI so they can be displayed as buttons.
***}
constructor Init (AParent: PWindowsObject; AnID, X, Y: Integer;
IsDefault: Boolean; iBmp: Integer; AStyle: Word);
procedure DefWndProc(Var Msg : TMessage); Virtual;
end;
PMDIStatic = ^TMDIStatic;
TMDIStatic = object(TMWCCStatic)
{***
This object declares the static as non-MDI so it can be displayed as a static.
***}
constructor Init (AParent: PWindowsObject; AnId: Integer; ATitle: PChar;
X, Y, W, H: Integer; ATextLen, AShade: Word; IsBold: Boolean);
end;
PMDIChild = ^TMDIChild;
TMDIChild = object(TWindow)
{***
This MDI Child to shows off the new TMWCCFontDlg common font dialog box.
***}
TheFont : HFont;
constructor Init(AParent: PWindowsObject; AName: PChar);
procedure GetWindowClass(var AWndClass: TWndClass); virtual;
procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
end;
PMDITool = ^TMDITool;
TMDITool = object(TMDIWindow)
BkBrush : HBrush;
But1, But2, But3, But4, But5, But6 : PMDIButton;
Stat1 : PMWCCStatic;
X, Y, W, H : Integer;
ToolbarPos : Word;
constructor Init (ATitle : PChar; AMenu : HMenu);
destructor Done; virtual;
function GetClassName : PChar; virtual;
function InitChild : PWindowsobject; virtual;
procedure GetWindowClass (var AWndClass: TWndClass); virtual;
procedure SetUpWindow; virtual;
procedure InitClientWindow; virtual;
procedure WMCtlColor (var Msg: TMessage); virtual wm_First + wm_CtlColor;
procedure WMDrawItem (var Msg: TMessage); virtual wm_First + wm_DrawItem;
procedure WMSize (var Msg: TMessage); virtual wm_First + wm_Size;
procedure TopToolbar(var Msg: TMessage); virtual;
procedure LeftToolbar(var Msg: TMessage); virtual;
procedure RightToolbar(var Msg: TMessage); virtual;
procedure IDMTopToolbar (var Msg: TMessage); virtual cm_First + idm_TopToolbar;
procedure IDMLeftToolbar (var Msg: TMessage); virtual cm_First + idm_LeftToolbar;
procedure IDMRightToolbar (var Msg: TMessage); virtual cm_First + idm_RightToolbar;
procedure IDMAbout (var Msg: TMessage); virtual cm_First + idm_About;
procedure IDWBut1 (var Msg: TMessage); virtual id_First + idw_But1;
procedure IDWBut2 (var Msg: TMessage); virtual id_First + idw_But2;
procedure IDWBut3 (var Msg: TMessage); virtual id_First + idw_But3;
procedure IDWBut4 (var Msg: TMessage); virtual id_First + idw_But4;
procedure IDWBut5 (var Msg: TMessage); virtual id_First + idw_But5;
procedure IDWBut6 (var Msg: TMessage); virtual id_First + idw_But6;
end;
PMDIToolApplication = ^TMDIToolApplication;
TMDIToolApplication = object(TApplication)
procedure InitMainWindow; virtual;
end;
var
ColorRef : TColorRef;
HLib : THandle;
{*** TLogFont Structure ***}
LogFont : TLogFont;
{********** TMDIToolApplication **********}
procedure TMDIToolApplication.InitMainWindow;
begin
MainWindow := New(PMDITool, Init('MDITool', LoadMenu(HInstance, 'MDIToolMenu')));
end;
{********** TMDITool **********}
constructor TMDITool.Init(ATitle : PChar; AMenu : HMenu);
begin
TMDIWindow.Init(ATitle, AMenu);
{***
This sets the error mode so that if MWCC.dll is not found a normal messagebox gets
diplayed (rather than an ugly white one). The error mode is then reset to the default.
***}
SetErrorMode(SEM_NoOpenFileErrorBox);
hLib := LoadLibrary ('MWCC.dll');
if hLib < 32 then
begin
MessageBox(0, 'Cannot find MWCC.DLL in your Windows System subdirectory.',
'Application Error', mb_Ok or mb_IconStop);
TerminateApp(0, No_UAE_Box);
end;
SetErrorMode(0);
Attr.X := GetSystemMetrics(sm_CXScreen) div 8;
Attr.Y := GetSystemMetrics(sm_CYScreen) div 8;
Attr.W := (GetSystemMetrics(sm_CXScreen) div 8)*6;
Attr.H := (GetSystemMetrics(sm_CYScreen) div 8)*5-4;
{*** The buttons are initialized with the dummy values and repositioned later in WMSize ***}
But1 := New(PMDIButton, Init(@Self, idw_But1, X, Y, False, 15, 0));
But2 := New(PMDIButton, Init(@Self, idw_But2, X, Y, False, 16, 0));
But3 := New(PMDIButton, Init(@Self, idw_But3, X, Y, False, 18, 0));
But4 := New(PMDIButton, Init(@Self, idw_But4, X, Y, False, 19, 0));
But5 := New(PMDIButton, Init(@Self, idw_But5, X, Y, False, 20, 0));
But6 := New(PMDIButton, Init(@Self, idw_But6, X, Y, False, 21, 0));
{***
The static is initialized with zero values and repositioned later in WMSize.
This static fills the gap between the last button and the window frame.
***}
Stat1 := New(PMDIStatic, Init(@Self, idw_Stat1, '', 0, 0, 0, 0, 0, ctl_Raised, False));
{*** Crates a brush the same color as the client area ***}
BkBrush := CreateSolidBrush(GetSysColor(color_AppWorkSpace));
{*** Positions the toolbar along the top ***}
ToolbarPos := ctl_Top;
end;
destructor TMDITool.Done;
begin
DeleteObject(BkBrush);
FreeLibrary(hLib);
TMDIWindow.Done;
end;
function TMDITool.GetClassName;
begin
GetClassName := AppName;
end;
function TMDITool.InitChild : PWindowsObject;
begin
InitChild := New(PMDIChild, Init(@Self, 'MDI Child Window'));
end;
procedure TMDITool.GetWindowClass (var AWndClass: TWndClass);
begin
TMDIWindow.GetWindowClass(AWndClass);
{***
Sets the MDI Window background to the same color as the client area so
that when the toolbar moves you don't see a different background color flash.
***}
AWndClass.HBrBackground := BkBrush;
AWndClass.HIcon := LoadIcon(HInstance, 'MDIIcon');
end;
procedure TMDITool.SetUpWindow;
begin
TMDIWindow.SetUpWindow;
CreateChild;
{*** Check the top menu item ***}
CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_Checked);
end;
procedure TMDITool.InitClientWindow;
begin
TMDIWindow.InitClientWindow;
with ClientWnd^.Attr do
Style := Style or ws_VScroll or ws_HScroll;
end;
procedure TMDITool.WMCtlColor(var Msg: TMessage);
begin
{***
TMWCCStatic paints the border around the static. To save on painting it doesn't fill
the centre. The CtlColor(Msg) does that. This means there is no repainting problems
when a covered static is uncovered etc etc.
***}
case Msg.LParamHi of
CtlColor_Static:
begin
SetBkMode(Msg.WParam, Transparent);
Msg.Result := GetStockObject(LtGray_Brush);
end;
else
TMDIWindow.DefWndProc(Msg);
end;
end;
procedure TMDITool.WMDrawItem (var Msg:tMessage);
{***
Draws the ownerdraw buttons.
***}
begin
with PDrawItemStruct(Msg.lParam)^ do
case CtlType of
odt_Button:
case CtlID of
idw_But1 : But1^.DrawItem(Msg);
idw_But2 : But2^.DrawItem(Msg);
idw_But3 : But3^.DrawItem(Msg);
idw_But4 : But4^.DrawItem(Msg);
idw_But5 : But5^.DrawItem(Msg);
idw_But6 : But6^.DrawItem(Msg);
end;
end;
end;
procedure TMDITool.WMSize(var Msg: TMessage);
var
CRect : TRect;
begin
{*** Gets the client cordinates in parent values. This is used to reposition the toolbar ***}
GetClientRect (HWindow, CRect);
with CRect do
begin
X := Left;
Y := Top;
W := Right;
H := Bottom;
end;
{*** The three positions for the Toolbar ***}
if ToolbarPos = ctl_Top then TopToolbar(Msg);
if ToolbarPos = ctl_Left then LeftToolbar(Msg);
if ToolbarPos = ctl_Right then RightToolbar(Msg);
{***
After moving the Toolbar the static is invalidated so it displays properly.
I didn't invalidate the buttons here as they only need to be invalidated when
they move relative to the client area. A call to DefWndProc at the button level
accomplishes this later.
***}
InValidateRect(Stat1^.HWindow, nil, True);
end;
procedure TMDITool.TopToolbar (var Msg: TMessage);
{***
TopToolbar places the toolbar along the top and readjusts the client area accordingly;
The -1 value makes sure you don't see a double black border around the buttons etc.
***}
begin
if not IsIconic(HWindow) then
begin
MoveWindow(But1^.HWindow, -1, -1, 74, 54, False);
MoveWindow(But2^.HWindow, 72, -1, 74, 54, False);
MoveWindow(But3^.HWindow, 145, -1, 74, 54, False);
MoveWindow(But4^.HWindow, 218, -1, 74, 54, False);
MoveWindow(But5^.HWindow, 291, -1, 74, 54, False);
MoveWindow(But6^.HWindow, 364, -1, 74, 54, False);
end;
MoveWindow(Stat1^.HWindow, 437, -1, W-436, 54, False);
if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
MoveWindow(ClientWnd^.HWindow, X, 53, W, H-53, True);
end;
procedure TMDITool.LeftToolbar (var Msg: TMessage);
{***
LeftToolbar moves the toolbar to the left side and readjusts the client area accordingly;
***}
begin
if not IsIconic(HWindow) then
begin
MoveWindow(But1^.HWindow, -1, -1, 74, 54, False);
MoveWindow(But2^.HWindow, -1, 52, 74, 54, False);
MoveWindow(But3^.HWindow, -1, 105, 74, 54, False);
MoveWindow(But4^.HWindow, -1, 158, 74, 54, False);
MoveWindow(But5^.HWindow, -1, 211, 74, 54, False);
MoveWindow(But6^.HWindow, -1, 264, 74, 54, False);
end;
MoveWindow(Stat1^.HWindow, -1, 317, 74, H-316, False);
if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
MoveWindow(ClientWnd^.HWindow, X+73, Y, W-73, H, True);
end;
procedure TMDITool.RightToolbar (var Msg: TMessage);
{***
RightToolbar moves the toolbar to the right side and readjusts the client area accordingly;
***}
begin
if not IsIconic(HWindow) then
begin
MoveWindow(But1^.HWindow, W-73, -1, 74, 54, False);
MoveWindow(But2^.HWindow, W-73, 52, 74, 54, False);
MoveWindow(But3^.HWindow, W-73, 105, 74, 54, False);
MoveWindow(But4^.HWindow, W-73, 158, 74, 54, False);
MoveWindow(But5^.HWindow, W-73, 211, 74, 54, False);
MoveWindow(But6^.HWindow, W-73, 264, 74, 54, False);
end;
MoveWindow(Stat1^.HWindow, W-73, 317, 74, H-316, False);
if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
MoveWindow(ClientWnd^.HWindow, X, Y, W-73, H, True);
end;
procedure TMDITool.IDMTopToolbar (var Msg: TMessage);
begin
{***
The main window needs to be invalidated when the toolbar changes positon
to ensure the controls move smoothly to the their position.
***}
InValidateRect(HWindow, nil, True);
{*** Resets the Toolbar constant ***}
ToolbarPos := ctl_Top;
WMSize(Msg);
{*** Checks the appropriate menu item ***}
CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_Checked);
CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_UnChecked);
CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_UnChecked);
end;
procedure TMDITool.IDMLeftToolbar (var Msg: TMessage);
begin
InValidateRect(HWindow, nil, True);
ToolbarPos := ctl_Left;
WMSize(Msg);
CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_UnChecked);
CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_Checked);
CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_UnChecked);
end;
procedure TMDITool.IDMRightToolbar (var Msg: TMessage);
begin
InValidateRect(HWindow, nil, True);
ToolbarPos := ctl_Right;
WMSize(Msg);
CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_UnChecked);
CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_UnChecked);
CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_Checked);
end;
procedure TMDITool.IDMAbout (var Msg: TMessage);
begin
Application^.ExecDialog(New(PAboutDialog, Init(@Self, 'AboutDialog', 'MWCC')));
end;
procedure TMDITool.IDWBut1 (var Msg:tMessage);
{*** An example of an open file dialog box ***}
var
Dir, Name, Ext: array[0..fsPathName] of Char;
ADlg : PSFXFileDlg;
begin
ADlg := (New(PSFXFileDlg, Init(@Self, 'SFXFileDlg', True)));
if ADlg <> nil then
begin
if ADlg^.Execute = idOk then
with ADlg^, OpenFileName do
begin
FileSplit(FilePath, Dir, Name, Ext);
Winexec(FilePath, sw_Normal);
end;
ADlg^.free
end;
end;
procedure TMDITool.IDWBut2 (var Msg:tMessage);
{***
An example of a save file as dialog box. Here nil sets the dialog box to light gray
instead of a bitmap pattern. False means its a save as file dialog box. True means open.
***}
var
Dir, Name, Ext: array[0..fsPathName] of Char;
ADlg : PMWCCFileDlg;
begin
ADlg := (New(PMWCCFileDlg, Init(@Self, 'MWCCFileDlg', nil, False)));
if ADlg <> nil then
begin
if ADlg^.Execute = idOk then
with ADlg^, OpenFileName do
begin
FileSplit(FilePath, Dir, Name, Ext);
MWCCMsgBox(HWindow, 'There is nothing to save but while your here ' +
'do you like this message box?.',
'Information', mb_YesNo or mb_IconQuestion, nil);
end;
ADlg^.free
end;
end;
procedure TMDITool.IDWBut3 (var Msg:tMessage);
{***
Minimum required to use TMWCCFontDlg. The font information from the font selected
in the dialog box is automatically transfered to the TLogFont structure. Using FontText
and lCustData you can customize the sample text displayed in the font dialog box. If
lCustData := 0 the default text will be used.
There are two resource templates, one for TMWCCFontDlg and one for TSFXFontDlg. As the file
MCommDlg.res contains all the dialog templates no unit actually calls this file. You will
have to add the appropriate template to you resource file. If you move the static control
number 1093 outside groupbox number 1073 or if cf_Both or cf_printerfonts is not specified
the Sample Text will re-centres itself inside the groupbox.
Customization. The only customizing you would want to do is to change the sample text. This
can be done as below so there is no need to dervie your own dialog objwect unless you want to
add something. You might want to center the dialog over the window or screen using the
CenterOverWindow or CentreOverScreen functions.
If you don't specify cf_Both or cf_Printerfonts then the dialog wont use static control
number 1093. I suggest you move this control outside the dialog along side the other unused
controls (don't delete it) and resize the Sample group box so it's narrower and longer. It
will then match the total lengths of the Combo boxes above and look better.
***}
var
FontRec : TChooseFont;
Style : array [0..100] of Char;
FontDlg : PMWCCFontDlg;
FontText : PChar;
ChildWnd : HWnd;
begin
FillChar(FontRec, SizeOf(FontRec), #0);
FontText := 'Sample';
with FontRec do
begin
lStructSize:= SizeOf(TChooseFont);
lpLogFont := @LogFont;
Flags := cf_Both or cf_Effects or cf_InitToLogFontStruct;
lCustData := LongInt(FontText);
rgbColors := ColorRef;
lpszStyle := Style;
end;
FontDlg := New(PMWCCFontDlg, Init(@Self, 'MWCCFontdlg', @FontRec, 'BWCC'));
if (FontDlg = nil) or (FontDlg^.Execute <> id_Ok) then Exit;
ColorRef:= FontRec.rgbColors;
{*** Add/replace your code here ***}
ChildWnd := SendMessage(ClientWnd^.HWindow, wm_MDIGetActive, 0, 0);
SendMessage(ChildWnd, wm_Paint, 0, 0);
end;
procedure TMDITool.IDWBut4 (var Msg:tMessage);
{***
The MWCCMsgBox and SFXMsgBox functions exactly mirror the Windows API Messagebox function.
They now take a window handle instead of a PWindowsObject pointer and can be used as a
stand alone message boxes or from within constructors by setting the Window hanlde to zero.
***}
begin
MWCCMsgBox(HWindow, 'This is an MWCC message box. It can be created using the ' +
'MWCCMsgBox function. MWCC message boxes can display one of ' +
'three custom backgrounds. This is the BWCC Background',
'MWCC Message Box', mb_YesNoCancel or mb_DefButton2 or
mb_IconInformation, 'BWCC');
end;
procedure TMDITool.IDWBut5 (var Msg:tMessage);
begin
MWCCMsgBox(HWindow, 'This is an MWCC message box. It can be created using the ' +
'MWCCMsgBox function. MWCC message boxes can display one of ' +
'three custom backgrounds. This is the MWCC Background',
'MWCC Message Box', mb_OkCancel or mb_IconStop, 'MWCC');
end;
procedure TMDITool.IDWBut6 (var Msg:tMessage);
begin
SFXMsgBox(HWindow, 'This is an SFX message box. It can be created using the SFXMsgBox ' +
'function.', 'SpecialFX Message Box', mb_AbortRetryIgnore or
mb_IconExclamation or mb_DefButton3);
end;
{********** TMDIChild **********}
constructor TMDIChild.Init (AParent: PWindowsObject; AName: PChar);
begin
TWindow.Init(AParent, AName);
with LogFont do
begin
lfHeight := -35;
lfWidth := 0;
lfEscapement := 0;
lfOrientation := 0;
lfWeight := 700;
lfItalic := 1;
lfUnderLine := 1;
lfStrikeout := 0;
lfCharSet := 0;
lfOutPrecision := Out_Stroke_Precis;
lfClipPrecision := Clip_Stroke_Precis;
lfQuality := Default_Quality;
lfPitchAndFamily := Variable_Pitch;
StrCopy(lfFaceName, 'Times New Roman');
end;
ColorRef := RGB(255, 0, 0);
end;
procedure TMDIChild.GetWindowClass (var AWndClass: TWndClass);
begin
TWindow.GetWindowClass(AWndClass);
AWndClass.HBrBackground := GetStockObject(Black_Brush);
end;
procedure TMDIChild.WMPaint (var Msg: TMessage);
var
PS : TPaintStruct;
CRect : TRect;
PaintDC : HDC;
OldObject : THandle;
begin
TWindow.WMPaint(Msg);
BeginPaint(HWindow, PS);
PaintDC := GetDC(HWindow);
SetTextColor(PaintDC, ColorRef);
SetBkMode(PaintDC, Transparent);
GetClientRect(HWindow, CRect);
FillRect(PaintDC, CRect, GetStockObject(Black_Brush));
TheFont := CreateFontIndirect(LogFont);
OldObject := SelectObject(PaintDC, TheFont);
DrawText(PaintDC, 'Borland Pascal 7.0', -1, CRect, dt_Center or dt_vCenter or dt_Singleline);
SelectObject(PaintDC, OldObject);
DeleteObject(TheFont);
ReleaseDC(HWindow, PaintDC);
EndPaint(HWindow, PS);
end;
{********** TMDIButton **********}
constructor TMDIButton.Init(AParent: PWindowsObject; AnID, X, Y: Integer;
IsDefault: Boolean; iBmp: Integer; AStyle: Word);
begin
TMWCCBmpButton.Init(Aparent, AnId, X, Y, IsDefault, iBmp, AStyle);
{***
These two line are important. They set the button objects to non MDI. Without these
lines you would see MDI child windows instead of buttons.
***}
SetFlags(wb_MDIChild, False);
DefaultProc := @DefWindowProc;
end;
procedure TMDIButton.DefWndProc(Var Msg : TMessage);
begin
with Msg do
if Message = wm_Move then
begin
InvalidateRect(HWindow, nil, True);
end
else
TMWCCBmpButton.DefWndProc(Msg);
end;
{********** TMDIStatic **********}
constructor TMDIStatic.Init (AParent: PWindowsObject; AnId: Integer; ATitle: PChar;
X, Y, W, H: Integer; ATextLen, AShade: Word; IsBold: Boolean);
begin
TMWCCStatic.Init(Aparent, AnId, ATitle, X, Y, W, H, ATextLen, AShade, IsBold);
{***
These two line are important. They set the static object to non MDI. Without these
lines you would see a MDI child window instead of a raised static.
***}
SetFlags(wb_MDIChild, False);
DefaultProc := @DefWindowProc;
end;
{********** TAboutDialog **********}
constructor TAboutDialog.Init(AParent: PWindowsObject; AName, ABmp: PChar);
{***
This initializes a recessed TMWCCStatic object and the BWCC style
Ok Button' (id 1) in MWCC.dll.
***}
begin
TMWCCDialog.Init(AParent, AName, ABmp);
Stat1 := New(PMWCCStatic, InitResource(@Self, idd_Stat1, 0, ctl_Recessed));
Stat2 := New(PMWCCStatic, InitResource(@Self, idd_Stat2, 0, ctl_Recessed));
if GetSystemMetrics(sm_CYSize) = 26 then
OkBut := New(PMWCCBmpButton, Init(@Self, id_Ok, 158, 216, False, 1, ctl_Flush))
else
OkBut := New(PMWCCBmpButton, Init(@Self, id_Ok, 116, 169, False, 1, ctl_Flush));
end;
procedure TAboutDialog.SetUpWindow;
begin
TMWCCDialog.SetUpWindow;
{*** Centres the About dialog over the MDITool client area ***}
CenterOverClient(Parent^.HWindow, HWindow);
end;
procedure TAboutDialog.WMDrawItem(var Msg:tMessage);
{*** Draws the Ok Button ***}
begin
with PDrawItemStruct(Msg.lParam)^ do
case CtlType of
odt_Button:
case CtlID of
id_Ok : OkBut^.DrawItem(Msg);
end;
end;
end;
{********** Main Program **********}
var
App: TMDIToolApplication;
begin
App.Init(AppName);
App.Run;
App.Done;
end.